package split_pair_combinations;

require Exporter;


our @ISA = qw(Exporter);
our $VERSION = 1.00;
our @EXPORT = qw(  split_pairs);


#88888888888888888888888888888888888888888888888888888888888888888888888888888888

#	Usage

#88888888888888888888888888888888888888888888888888888888888888888888888888888888

#USAGE:
#
#    split_pair_combinations.pl
#                [--suffix output_file_suffix]
#                [--prefixed output_file_suffix]
#                [--col_header]
#                (files...)
#
#    Accepts arrays of pairs of strings
#    returns 4 arrays:
#        1_to_1
#        1_to_m
#        m_to_1
#        m_to_m
#USAGE



#88888888888888888888888888888888888888888888888888888888888888888888888888888888

#	uniquify

#			removes duplicate entries in an array

#88888888888888888888888888888888888888888888888888888888888888888888888888888888
sub uniquify(\@)
{
	my %hash;
	@hash{@{$_[0]}} = ();
	@{$_[0]} = keys %hash;	
	return @{$_[0]};
}	

sub split_pairs(\@$)
{
	my ($lines, $verbose) = @_;

	


	print STDERR "\t\tFilling look up tables...\n"
		if ($verbose);

	# the two relationships for each pair
	my %a_to_b;
	my %b_to_a;
	my @a_b;
	for $pair(@$lines)
	{
		if (!exists $a_to_b{$pair->[0]}{$pair->[1]})
		{
			$a_to_b{$pair->[0]}{$pair->[1]}++;
			$b_to_a{$pair->[1]}{$pair->[0]}++;
			die if $a_to_b{$pair->[0]}{$pair->[1]} > 1 or
					$b_to_a{$pair->[1]}{$pair->[0]} > 1;
			push(@a_b,  $pair);
		}
	}
	
	my @res_1_TO_1;
	my @res_1_TO_M;
	my @res_M_TO_1;
	my @res_M_TO_M;
	
	print STDERR "\t\tSorting by category...\n"
		if ($verbose);

	for (@a_b)
	{
		my ($a,  $b) = @$_;
		# to many
		if (keys %{$a_to_b{$a}} > 1)
		{
			if (keys %{$b_to_a{$b}} > 1)
			{
				# many to many
				push (@res_M_TO_M,  [$a, $b]);
			}
			else
			{
				# one to many
				push (@res_1_TO_M,  [$a, $b]);
			}
		}
		# to one
		else
		{
			if (keys %{$b_to_a{$b}} > 1)
			{
				# many to one
				push (@res_M_TO_1,  [$a, $b]);
			}
			else
			{
				# one to one
				push (@res_1_TO_1,  [$a, $b]);
			}
		}
	}

	my @a = sort keys %a_to_b;
	my @one_a;
	my @many_a;
	for my $a(@a)
	{
		# to many
		if (keys %{$a_to_b{$a}} > 1)
		{
			push (@many_a,  $a);
		}
		else
		{
			push (@one_a,  $a);
		}
	}
	my @b = sort keys %b_to_a;
	my @one_b;
	my @many_b;
	for my $b(@b)
	{
		# to many
		if (keys %{$b_to_a{$b}} > 1)
		{
			push (@many_b,  $b);
		}
		else
		{
			push (@one_b,  $b);
		}
	}


	@res_1_TO_1 = sort{return $a->[0] cmp $b->[0] or $a->[1] cmp $b->[1]} (@res_1_TO_1);
	if ($verbose)
	{
		print STDERR "\t", '-'x6, "\n";
		
		print STDERR "\t", scalar @$lines, "\trelationships supplied\n";
		print STDERR "\t", scalar @a_b, "\tunique relationships supplied\n";
		print STDERR "\t", scalar @a, "\titems on the left side\n";
		print STDERR "\t", scalar @one_a, "\titems on the left side in one to ?\n";
		print STDERR "\t", scalar @many_a, "\titems on the left side in many to ?\n";
		print STDERR "\t", scalar @b, "\titems on the right side\n";
		print STDERR "\t", scalar @one_b, "\titems on the right side in one to ?\n";
		print STDERR "\t", scalar @many_b, "\titems on the right side in many to ?\n";
		print STDERR "\t", scalar @res_1_TO_1, "\tone to one\n";
		print STDERR "\t", scalar @res_1_TO_M, "\tone to many\n";
		print STDERR "\t", scalar @res_M_TO_1, "\tmany to one\n";
		print STDERR "\t", scalar @res_M_TO_M, "\tmany to many\n";
	}
	
	return(\@res_1_TO_1, \@res_1_TO_M, \@res_M_TO_1, \@res_M_TO_M, \@a, \@one_a, \@many_a, \@b, \@one_b, \@many_b);
}

return 1;
